-- {-# LANGUAGE TemplateHaskell #-}
module Strategy
        ( Strategy (..)
        , StrategyEvaluator (..)
        , StrategyRunner (..)
        , BaseEvaluator (..)
        , BarModifier (..)
        , StrategyInput (..)
        )
        where

import Data.Maybe
import Types
import Fetcher
import Data.Time.LocalTime
import Control.Monad
import Distribution.Time
import Numeric
-- import System.Log.Logger.TH (deriveLoggers)
-- import qualified System.Log.Logger as HSL

-- $(deriveLoggers "HSL" [HSL.INFO])

type Changes = [(Double, Double)]

data StrategyInput = StrategyInput {
        siMinLow          :: Changes,
        siMinHigh         :: Changes,
        siHourLow         :: Changes,
        siHourHigh        :: Changes,
        siDayLow          :: Double,
        siDayHigh         :: Double,
        siOpenPrice       :: Double
        }

-- Strategy class definition
class Strategy m where
        -- feeds minute, hour and day bar into strategy
        stProcess :: m->StrategyInput->(m, [Order])

-- so, the process of back-testing is as follows:
-- 1. For given day t, get minute, hour and day bar
-- 2. Feed those data into Strategy
-- 3. Evaluate strategy orders by day bar at (t+1) day bar
-- 4. Accumulate strategy outcome

class (Fetcher s, StrategyEvaluator s) => StrategyRunner s where
        runStrategy :: Strategy st => s->st->Int->LocalTime->LocalTime->IO (s, [Maybe Double])
        runStrategy s st symbol fd td = foldM evaluator (s, []) days
                where   days = getWorkDays fd td
                        evaluator (a, r) d = liftM (add (a, r)) $ oneBarStrategy a st symbol d
                        add (a, x) (b, y)  = (b, y:x)

loadSiForDay :: Fetcher s=> s->Int->LocalTime->IO StrategyInput
loadSiForDay f symbol d = do
        mlow <- getLow MinuteBar
        mhigh <- getHigh MinuteBar
        hlow <- getLow HourBar
        hhigh <- getHigh HourBar
        dbar <- getDay d
        dnextbar <- getDay nextDay
        return StrategyInput {
                siMinLow        = mlow,
                siMinHigh       = mhigh,
                siHourLow       = hlow,
                siHourHigh      = hhigh,
                siDayLow        = (barOpen dbar) - (barLow dbar),
                siDayHigh       = (barHigh dbar) - (barOpen dbar),
                siOpenPrice     = (barOpen dnextbar)
        }
        where   getLow b = fGetLow f b symbol d nextDay
                getHigh b = fGetHigh f b symbol d nextDay
                getDay = fGetBar f DayBar symbol
                nextDay = getNextWorkDay d

oneBarStrategy :: (Strategy s, StrategyEvaluator a, Fetcher a) =>a -> s -> Int -> LocalTime -> IO (a, Maybe Double)
oneBarStrategy s st symbol day = do
        si <- loadSiForDay s symbol day
        let orders = stProcess st si
        putStrLn ("Processing day:"++(show day))
        putStrLn $ show $ snd orders
        bar <- fGetBar s DayBar symbol (getNextWorkDay day)
        putStrLn $ show bar
        let orderEval = evalOrders s bar (snd orders)
        putStrLn $ showMaybe $ snd orderEval
        return orderEval
                        
-- Strategy evaluations
class BarModifier m => StrategyEvaluator m where
        evalOrders :: m->BarData->[Order]->(m, Maybe Double)
        evalOrders b bar orders = (b, (pnl barResults))
                where   pnl :: [(Maybe Double)] -> (Maybe Double)
                        pnl (x:xs)      = foldl maybeMin x xs
                        pnl []          = Nothing
                        barResults      = filter isJust $ map (evalOrder b bar) orders
                        maybeMin (Just x) (Just y)      = Just (min x y)
                        maybeMin (Just x) Nothing       = Just x
                        maybeMin Nothing  (Just x)      = Just x
                        maybeMin _      _               = Nothing

data BaseEvaluator = BaseEvaluator {
        beSpread :: Double
        }

class BarModifier m where
        getAskBar :: m->BarData->BarData
        getBidBar :: m->BarData->BarData

instance BarModifier BaseEvaluator where
        getAskBar (BaseEvaluator s) (BarData o h l c v) = BarData (o-s) (h-s) (l-s) (c-s) v
        getBidBar m b = b

instance StrategyEvaluator BaseEvaluator

-- as we assume that db stores only bid bars, so we have to adjust our bar to bid ask bar for sell orders
modifyBarForOrder m b (BuyOrder _ _ _ _) = getBidBar m b
modifyBarForOrder m b (SellOrder _ _ _ _) = getAskBar m b

evalOrder m bar order
        | price <= (barHigh b) && price >= (barLow b) = evalOrderOnBar order b
        | otherwise  = Nothing
        where
                b = modifyBarForOrder m bar order
                price = orderPrice order

evalOrderOnBar (BuyOrder v price sl tp) bar 
        | sl >= (barLow bar)      = Just ((sl-price)*v)
        | tp <= (barHigh bar)     = Just ((tp-price)*v)
        | otherwise               = Just 0.0


evalOrderOnBar (SellOrder v price sl tp) bar
        | sl <= (barHigh bar)     = Just ((price-sl)*v)
        | tp >= (barLow bar)      = Just ((price-tp)*v)
        | otherwise               = Just 0.0

